home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-06 / qb_ipx.zip / IPX.BAS < prev    next >
BASIC Source File  |  1992-08-03  |  6KB  |  239 lines
  1. '--------------------------------------------------------------------'
  2. '                                                                    '
  3. '                                                                    '
  4. '--------------------------------------------------------------------'
  5. '
  6. DEFINT A-Z
  7. DECLARE SUB RelenquishControl ()
  8. DECLARE SUB SocketListen ()
  9. DECLARE SUB CloseSocket (Socket%)
  10. DECLARE SUB SendPacket (CompleteCode%, InUseFlag%)
  11. DECLARE SUB OpenSocket (Socket%, Status%, SocketNumberReturned%)
  12. DECLARE SUB IPXMarker (Interval%)
  13. DECLARE SUB GetMyAddress (MyNetwork$, MyNode$, MyNetworkHex$, MyNodeHex$)
  14. DECLARE SUB IPXCancel (CompleteCode%)
  15. DECLARE SUB IPXSchedule (DelayTicks%)
  16. DECLARE SUB IPXDisconnect (DNet$, DNode$, DSock$)
  17. DECLARE FUNCTION SplitWordLo% (TheWord%)
  18. DECLARE FUNCTION SplitWordHi% (TheWord%)
  19. DECLARE FUNCTION IPXInstalled% ()
  20. DECLARE FUNCTION TurnToHex$ (Variable$)
  21. DECLARE FUNCTION HexToBinary$ (Variable$)
  22. '
  23. '           Define the DOS Interrupt registers.
  24. '
  25. TYPE RegTypeX
  26.    AX    AS INTEGER
  27.    BX    AS INTEGER
  28.    CX    AS INTEGER
  29.    DX    AS INTEGER
  30.    BP    AS INTEGER
  31.    SI    AS INTEGER
  32.    DI    AS INTEGER
  33.    FLAGS AS INTEGER
  34.    DS    AS INTEGER
  35.    ES    AS INTEGER
  36. END TYPE
  37. '                             
  38. '              This is the Event Control Block Structure.
  39. '
  40. TYPE ECBStructure
  41.    LinkAddressOff AS INTEGER
  42.    LinkAddressSeg AS INTEGER
  43.    ESRAddressOff  AS INTEGER
  44.    ESRAddressSeg  AS INTEGER
  45.    InUse       AS STRING * 1
  46.    CompCode    AS STRING * 1
  47.    SockNum     AS INTEGER
  48.    IPXWorkSpc  AS SINGLE
  49.    DrvWorkSpc  AS STRING * 12
  50.    ImmAdd      AS STRING * 6
  51.    FragCount   AS INTEGER
  52.    FragAddOfs  AS INTEGER
  53.    FragAddSeg  AS INTEGER
  54.    FragSize    AS INTEGER
  55. END TYPE
  56. '
  57. '              This is the IPX Packet Structure.
  58. '
  59. TYPE IPXHeader
  60.    Checksum    AS INTEGER
  61.    Length      AS INTEGER
  62.    Control     AS STRING * 1
  63.    PacketType  AS STRING * 1
  64.    DestNet     AS STRING * 4
  65.    DestNode    AS STRING * 6
  66.    DestSocket  AS STRING * 2
  67.    SourNet     AS STRING * 4
  68.    SourNode    AS STRING * 6
  69.    SourSock    AS STRING * 2
  70.    DataGram    AS STRING * 546
  71. END TYPE
  72. '
  73. TYPE FullNetAddress
  74.    NetWork     AS STRING * 4
  75.    Node        AS STRING * 6
  76.    Socket      AS STRING * 2
  77. END TYPE
  78. '
  79. TYPE RouterAddress
  80.    Node        AS STRING * 6
  81. END TYPE
  82. '
  83. DIM SHARED IPXS AS IPXHeader, IPXR AS IPXHeader
  84. DIM SHARED ECBS AS ECBStructure, ECBR AS ECBStructure
  85. DIM SHARED InReg AS RegTypeX, OutReg AS RegTypeX
  86. DIM SHARED GetMyAdd AS FullNetAddress
  87. DIM SHARED LTAdd AS FullNetAddress, Disconnect AS FullNetAddress
  88. DIM SHARED GetImmAdd AS RouterAddress
  89. '
  90.  
  91. SUB CloseSocket (Socket%)
  92.    InReg.BX = 1
  93.    InReg.AX = 0
  94.    InReg.DX = Socket
  95.    CALL InterruptX(&H7A, InReg, OutReg)
  96. END SUB
  97.  
  98. SUB GetMyAddress (MyNetwork$, MyNode$, MyNetworkHex$, MyNodeHex$)
  99.    InReg.BX = &H9
  100.    InReg.ES = VARSEG(GetMyAdd)
  101.    InReg.SI = VARPTR(GetMyAdd)
  102.    CALL InterruptX(&H7A, InReg, OutReg)
  103.    MyNetwork$ = GetMyAdd.NetWork
  104.    MyNode$ = GetMyAdd.Node
  105.    MyNetworkHex$ = TurnToHex$(MyNetwork$)
  106.    MyNodeHex$ = TurnToHex$(MyNode$)
  107. END SUB
  108.  
  109. FUNCTION HexToBinary$ (Variable$)
  110.    IF Variable$ = "" THEN
  111.       HexToBinary$ = ""
  112.    ELSE
  113.       A = LEN(Variable$) MOD 2
  114.       IF A = 1 THEN
  115.          HexToBinary$ = ""
  116.       ELSE
  117.          Temp$ = ""
  118.          FOR A = 1 TO LEN(Variable$) STEP 2
  119.             Temp! = VAL("&H" + MID$(Variable$, A, 2))
  120.             Temp$ = Temp$ + CHR$(Temp!)
  121.          NEXT
  122.          HexToBinary$ = Temp$
  123.       END IF
  124.    END IF
  125. END FUNCTION
  126.  
  127. SUB IPXCancel (CompleteCode%)
  128.    InReg.BX = 6
  129.    InReg.ES = VARSEG(ECBS)
  130.    InReg.SI = VARPTR(ECBS)
  131.    CALL InterruptX(&H7A, InReg, OutReg)
  132.    CompleteCode = SplitWordLo%(OutReg.AX)
  133. END SUB
  134.  
  135. SUB IPXDisconnect (DNet$, DNode$, DSock$)
  136.    Disconnect.NetWork = DNet$
  137.    Disconnect.Node = DNode$
  138.    Disconnect.Socket = DSock$
  139.    InReg.BX = &HB
  140.    InReg.ES = VARSEG(Disconnect)
  141.    InReg.SI = VARPTR(Disconnect)
  142.    CALL InterruptX(&H7A, InReg, OutReg)
  143. END SUB
  144.  
  145. FUNCTION IPXInstalled%
  146.    InReg.AX = &H7A00
  147.    CALL InterruptX(&H2F, InReg, OutReg)
  148.    AL = SplitWordLo(OutReg.AX)
  149.    IF AL = &HFF THEN IPXInstalled = 1 ELSE IPXInstalled = 0
  150. END FUNCTION
  151.  
  152. SUB IPXMarker (Interval%)
  153.    InReg.BX = 8
  154.    CALL InterruptX(&H7A, InReg, OutReg)
  155.    Interval = OutReg.AX
  156. END SUB
  157.  
  158. SUB IPXSchedule (DelayTicks%)
  159.    InReg.AX = DelayTicks%
  160.    InReg.BX = 5
  161.    InReg.ES = VARSEG(ECBS)
  162.    InReg.SI = VARPTR(ECBS)
  163.    CALL InterruptX(&H7A, InReg, OutReg)
  164.    CompleteCode = ASC(ECBS.CompCode)
  165.    InUseFlag = ASC(ECBS.InUse)
  166. END SUB
  167.  
  168. SUB OpenSocket (Socket%, Status%, SocketNumberReturned%)
  169.    InReg.BX = 0
  170.    InReg.AX = 0
  171.    InReg.DX = Socket
  172.    CALL InterruptX(&H7A, InReg, OutReg)
  173.    Status = SplitWordLo(OutReg.AX)
  174.    SocketNumberReturned = OutReg.DX
  175.    '
  176.    '           Completion status
  177.    '                    00 successful
  178.    '                    FF open already
  179.    '                    FE socket table is full
  180. END SUB
  181.  
  182. SUB RelenquishControl
  183.    DEFINT A-Z
  184.    InReg.AX = 0
  185.    InReg.BX = &HA
  186.    CALL InterruptX(&H7A, InReg, OutReg)
  187. END SUB
  188.  
  189. SUB SendPacket (CompleteCode%, InUseFlag%)
  190.    InReg.BX = 3
  191.    InReg.ES = VARSEG(ECBS)
  192.    InReg.SI = VARPTR(ECBS)
  193.    CALL InterruptX(&H7A, InReg, OutReg)
  194.    CompleteCode = ASC(ECBS.CompCode)
  195.    InUseFlag = ASC(ECBS.InUse)
  196.    '
  197.    '        Error codes:
  198.    '              00    sent
  199.    '              FC    canceled
  200.    '              FD    malformed packet
  201.    '              FE    no listener (undelivered)
  202.    '              FF    hardware failure
  203. END SUB
  204.  
  205. SUB SocketListen
  206.    InReg.BX = 4
  207.    InReg.ES = VARSEG(ECBR)
  208.    InReg.SI = VARPTR(ECBR)
  209.    CALL InterruptX(&H7A, InReg, OutReg)
  210.    '
  211.    '        Completion codes:
  212.    '              00    received
  213.    '              FC    canceled
  214.    '              FD    packet overflow
  215.    '              FF    socket was closed
  216. END SUB
  217.  
  218. FUNCTION SplitWordHi (TheWord%)
  219.    SplitWordHi = (TheWord% AND &HFF00) / 256
  220. END FUNCTION
  221.  
  222. FUNCTION SplitWordLo (TheWord%)
  223.    SplitWordLo = (TheWord% AND &HFF)
  224. END FUNCTION
  225.  
  226. FUNCTION TurnToHex$ (Variable$)
  227.    Temp$ = ""
  228.    FOR Byte = 1 TO LEN(Variable$)
  229.       Value! = ASC(MID$(Variable$, Byte, 1))
  230.       IF Value! < 15 THEN
  231.          Temp$ = Temp$ + "0" + HEX$(Value!)
  232.       ELSE
  233.          Temp$ = Temp$ + HEX$(Value!)
  234.       END IF
  235.    NEXT
  236.    TurnToHex$ = Temp$
  237. END FUNCTION
  238.  
  239.